home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / xlisp.lbr / XLSTR.CQ / xlstr.c
Encoding:
C/C++ Source or Header  |  1985-06-03  |  5.4 KB  |  237 lines
  1.                   /* xlstr - xlisp string builtin functions */
  2.  
  3. #ifdef CI_86
  4. #include "a:stdio.h"
  5. #include "xlisp.h"
  6. #endif
  7.  
  8. #ifdef AZTEC
  9. #include "a:stdio.h"
  10. #include "xlisp.h"
  11. #endif
  12.  
  13. #ifdef unix
  14. #include <stdio.h>
  15. #include <xlisp.h>
  16. #endif
  17.  
  18.  
  19.                             /* external variables */
  20.  
  21. extern struct node *xlstack;
  22.  
  23.  
  24.                             /* external procedures */
  25.  
  26. extern char *strcat();
  27.  
  28.  
  29.                        /*********************************
  30.                        *  xstrlen - length of a string  *
  31.                        *********************************/
  32.  
  33. static struct node *xstrlen(args)
  34.   struct node *args;
  35. {
  36.     struct node *oldstk,arg,*val;
  37.     int total;
  38.  
  39.     oldstk = xlsave(&arg,NULL);
  40.     arg.n_ptr = args;
  41.     total = 0;
  42.  
  43.     while (arg.n_ptr != NULL)
  44.         total += strlen(xlevmatch(STR,&arg.n_ptr)->n_str);
  45.  
  46.     xlstack = oldstk;
  47.  
  48.     val = newnode(INT);
  49.     val->n_int = total;
  50.  
  51.     return (val);
  52. }
  53.  
  54.  
  55.                  /*********************************************
  56.                  *  xstrcat - concatenate a bunch of strings  *
  57.                  *********************************************/
  58.  
  59.  
  60. static struct node *xstrcat(args)
  61.   struct node *args;
  62. {
  63. /*              this routine does it the dumb way -- one at a time */
  64.     struct node *oldstk,arg,val,rval;
  65.     int newlen;
  66.     char *result,*argstr,*newstr;
  67.  
  68.     oldstk = xlsave(&arg,&val,&rval,NULL);
  69.     arg.n_ptr = args;
  70.     rval.n_ptr = newnode(STR);
  71.     rval.n_ptr->n_str = result = stralloc(0);
  72.     *result = 0;
  73.  
  74.     while (arg.n_ptr != NULL) {
  75.         val.n_ptr = xlevmatch(STR,&arg.n_ptr);
  76.         argstr = val.n_ptr->n_str;
  77.         newlen = strlen(result) + strlen(argstr);
  78.         newstr = stralloc(newlen);
  79.         strcpy(newstr,result);
  80.         strfree(result);
  81.         rval.n_ptr->n_str = result = strcat(newstr,argstr);
  82.     }
  83.  
  84.     xlstack = oldstk;
  85.     return (rval.n_ptr);
  86. }
  87.  
  88.  
  89.                         /********************************
  90.                         *  substr - return a substring  *
  91.                         ********************************/
  92.  
  93. static struct node *substr(args)
  94.   struct node *args;
  95. {
  96.     struct node *oldstk,arg,src,val;
  97.     int start,forlen,srclen;
  98.     char *srcptr,*dstptr;
  99.  
  100.     oldstk = xlsave(&arg,&src,&val,NULL);
  101.     arg.n_ptr = args;
  102.  
  103.     src.n_ptr = xlevmatch(STR,&arg.n_ptr);
  104.     srcptr = src.n_ptr->n_str;
  105.     srclen = strlen(srcptr);
  106.  
  107.     start = xlevmatch(INT,&arg.n_ptr)->n_int;
  108.  
  109.     if (arg.n_ptr != NULL)
  110.         forlen = xlevmatch(INT,&arg.n_ptr)->n_int;
  111.     else
  112.         forlen = srclen;                /* use len and fix below */
  113.  
  114.     xllastarg(arg.n_ptr);
  115.  
  116.     if (start + forlen > srclen)
  117.         forlen = srclen - start + 1;
  118.  
  119.     if (start > srclen)
  120.     {
  121.         start = 1;
  122.         forlen = 0;
  123.     }
  124.  
  125.     val.n_ptr = newnode(STR);
  126.     val.n_ptr->n_str = dstptr = stralloc(forlen);
  127.  
  128.     for (srcptr += start-1; forlen--; *dstptr++ = *srcptr++)
  129.         ;
  130.  
  131.     *dstptr = 0;
  132.  
  133.     xlstack = oldstk;
  134.     return (val.n_ptr);
  135. }
  136.  
  137.  
  138.                         /*******************************
  139.                         *  ascii - return ascii value  *
  140.                         *******************************/
  141.  
  142. static struct node *ascii(args)
  143.   struct node *args;
  144. {
  145.     struct node *oldstk,val;
  146.  
  147.     oldstk = xlsave(&val,NULL);
  148.  
  149.     val.n_ptr = newnode(INT);
  150.     val.n_ptr->n_int = *(xlevmatch(STR,&args)->n_str);
  151.  
  152.     xllastarg(args);
  153.  
  154.     xlstack = oldstk;
  155.     return (val.n_ptr);
  156. }
  157.  
  158.  
  159.           /***********************************************************
  160.           *  chr - convert an INT into a one character ascii string  *
  161.           ***********************************************************/
  162.  
  163. static struct node *chr(args)
  164.   struct node *args;
  165. {
  166.     struct node *oldstk,val;
  167.     char *sptr;
  168.  
  169.     oldstk = xlsave(&val,NULL);
  170.  
  171.     val.n_ptr = newnode(STR);
  172.     val.n_ptr->n_str = sptr = stralloc(1);
  173.     *sptr++ = xlevmatch(INT,&args)->n_int;
  174.     *sptr = 0;
  175.  
  176.     xllastarg(args);
  177.  
  178.     xlstack = oldstk;
  179.     return (val.n_ptr);
  180. }
  181.  
  182.  
  183.                /**************************************************
  184.                *  xatoi - convert an ascii string to an integer  *
  185.                **************************************************/
  186.  
  187. static struct node *xatoi(args)
  188.   struct node *args;
  189. {
  190.     struct node *val;
  191.     int n;
  192.  
  193.     n = atoi(xlevmatch(STR,&args)->n_str);
  194.  
  195.     xllastarg(args);
  196.  
  197.     val = newnode(INT);
  198.     val->n_int = n;
  199.     return (val);
  200. }
  201.  
  202.  
  203.                /**************************************************
  204.                *  xitoa - convert an integer to an ascii string  *
  205.                **************************************************/
  206.  
  207. static struct node *xitoa(args)
  208.   struct node *args;
  209. {
  210.     struct node *val;
  211.     char buf[20];
  212.  
  213.     sprintf(buf,"%d",xlevmatch(INT,&args)->n_int);
  214.  
  215.     xllastarg(args);
  216.  
  217.     val = newnode(STR);
  218.     val->n_str = strsave(buf);
  219.     return (val);
  220. }
  221.  
  222.  
  223.                /**************************************************
  224.                *  xlsinit - xlisp string initialization routine  *
  225.                **************************************************/
  226.  
  227. xlsinit()
  228. {
  229.     xlsubr("strlen",xstrlen);
  230.     xlsubr("strcat",xstrcat);
  231.     xlsubr("substr",substr);
  232.     xlsubr("ascii",ascii);
  233.     xlsubr("chr", chr);
  234.     xlsubr("atoi",xatoi);
  235.     xlsubr("itoa",xitoa);
  236. }
  237.